home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Taifun / Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).zip / Taifun 102 (1989-08-15)(Ossowski, Stefan)(DE)(PD).adf / Life_Research / Game of Life 2.0 < prev    next >
Text File  |  1989-04-21  |  22KB  |  825 lines
  1. CLEAR ,70000&: DEFINT a-y
  2. DIM cs(7,999),sw(1,49,149),b$(4),item(1,15),a(2)
  3. DATA 1,1,0,0,0,0,0,0,0,1,1,0,0,1,1
  4. FOR n=0 TO 14
  5.   READ a
  6.   item(0,n)=a
  7.   item(1,n)=ABS(a-1)
  8. NEXT n
  9. nnbI=1:nnbII=1
  10.  
  11. SCREEN 1,640,250,2,2
  12.   WINDOW 9,"mem ",(556,92)-(631,236),20,1
  13.   GOSUB ColorReset
  14.   FOR n=0 TO 120 STEP 24
  15.     LINE (1,n+1)-(52,n+22),1,b
  16.     LOCATE INT(n/8)+2,9:PRINT CHR$(65+n/24)
  17.   NEXT n
  18.   WINDOW 8,"co-ordinates         ",(0,212)-(132,236),16,1
  19.   PRINT "mode :"
  20.   PRINT "   x :"
  21.   PRINT "   y :";     
  22.   WINDOW 10,"message                                       ",(144,212)-(544,236),0,1
  23.   COLOR 2:PRINT "welcome to GAME OF LIFE";
  24.   MENU 1,0,1,"about"
  25.   MENU 1,1,1,"                                "
  26.   MENU 1,2,1,"  Game Of Life Research Program "
  27.   MENU 1,3,1,"                                "
  28.   MENU 1,4,1,"           Release 2.0          "
  29.   MENU 1,5,1,"                                "
  30.   MENU 1,6,1,"  Oktober 1988 by Rainer Umbach "
  31.   MENU 1,7,1,"                                "
  32.   MENU 2,0,1,"go ahead"
  33.   MENU 2,1,1,"normal simulation         "
  34.   MENU 2,2,1,"single step simulation    "
  35.   MENU 2,4,1,"suicide                   "
  36.   MENU 3,0,1,"mem`s"
  37.   MENU 3,1,1,"> a <"
  38.   MENU 3,2,1,"> b <"
  39.   MENU 3,3,1,"> c <"
  40.   MENU 3,4,1,"> d <"
  41.   MENU 3,5,1,"> e <"
  42.   MENU 3,6,1,"> f <"
  43.   MENU 3,7,1,"break"
  44.   MENU 4,0,1,"copy"
  45.   MENU 4,1,1,"memory into window      "
  46.   MENU 4,2,1,"part of window to memory"
  47.   MENU 4,3,1,"buffer to memory        "
  48.   MENU 4,4,1,"memory to buffer        "
  49.   MENU 4,5,1,"memory to memory        "
  50.   MENU 5,0,1,"logical operations"
  51.   MENU 5,1,1,"buffer AND memory"
  52.   MENU 5,2,1,"buffer OR  memory"
  53.   MENU 5,3,1,"buffer XOR memory"
  54.   MENU 6,0,1,"edit"
  55.   MENU 6,1,1,"erase buffer        "
  56.   MENU 6,2,1,"erase part of window"
  57.   MENU 6,3,1,"erase whole window  "
  58.   MENU 6,4,1,"inverse buffer      "
  59.   MENU 6,5,1,"grid off            "
  60.   MENU 7,0,1,"disk"
  61.   MENU 7,1,1,"save memory"
  62.   MENU 7,2,1,"load memory"
  63.   MENU 7,3,1,"save window"
  64.   MENU 7,4,1,"load window"
  65.   MENU 7,5,1,"directory  "
  66.   MENU ON
  67. GOTO scs
  68.  
  69. ssm:
  70.  
  71.   ON ERROR GOTO ssmFehler
  72.   WINDOW CLOSE 5
  73.   h$=SPACE$(50)
  74.   WINDOW 3,"structure simulation mode"+h$,(0,0)-(600,200),16,1
  75.   wi=3:GOSUB just:GOSUB setMENU
  76.   MENU 2,3,1,"structure construction set"
  77.   CALL ssmGitter
  78.   IF nnbII=0 THEN
  79.     wi=wi-3:a=0
  80.     FOR m=1 TO 200 STEP 4
  81.       b=0
  82.       FOR n=1 TO 600 STEP 4
  83.         IF sw(wi,a,b) THEN LINE (n,m)-(n+2,m+2),3,bf
  84.         b=b+1
  85.       NEXT n
  86.       a=a+1
  87.     NEXT m
  88.     wi=wi+3
  89.   END IF
  90.   mess=6:GOTO messageFresh
  91.   
  92.   ssmRefresh:
  93.     WINDOW OUTPUT 8:LOCATE 1,8:COLOR 2:PRINT "ssm mouse"
  94.     WINDOW OUTPUT 3
  95.     CALL ssmMouse(x,y,c)
  96.     men=MENU(0)
  97.     meno=MENU(1)
  98.     IF men=2 THEN
  99.       ON meno GOTO ssmStartenI,ssmStartenII,scs,suicide
  100.     ELSEIF men=4 THEN
  101.       IF meno=1 THEN ssmSetzen
  102.       IF meno=2 THEN ssmLesen
  103.       IF meno=5 THEN Kopieren
  104.     ELSEIF men=6 THEN
  105.       IF meno=2 THEN ssmLoeschen
  106.       IF meno=3 THEN ssmErase
  107.     ELSEIF men=7 THEN
  108.       ON meno GOTO Sichern,Laden,ssmSichern,ssmLaden,Directory
  109.     END IF
  110.     GOTO ssmRefresh
  111.     
  112.   ssmFehler:
  113.     CALL Fehleranzeige
  114.     WINDOW OUTPUT wi
  115.     RESUME ssmRefresh
  116.  
  117.   ssmLoeschen:
  118.     WINDOW OUTPUT 10:COLOR 2:PRINT 
  119.       PRINT "enter co-ordinates of area to erase, it`s a frame" 
  120.       PRINT "use mouse pointer and left mouse botton" 
  121.       PRINT "first top/left, then bottom/right";
  122.     WINDOW OUTPUT wi
  123.     GOSUB catchtheMouse
  124.     x1=x*4:y1=y*4:x3=x1:y3=y1
  125.   ssmLoeschenMarke:
  126.     CALL ssmMouse(x,y,c)
  127.     a=x*4:b=y*4
  128.     IF a>=x1 THEN x2=a:ELSE x2=x1
  129.     IF b>=y1 THEN y2=b:ELSE y2=y1 
  130.     IF x2<>x3 OR y2<>y3 THEN
  131.       LINE (x1,y1)-(x3+4,y3+4),1,b
  132.       LINE (x1,y1)-(x2+4,y2+4),2,b:x3=x2:y3=y2
  133.     END IF
  134.     IF c<>0 THEN ssmLoeschenMarke
  135.     LINE (x1,y1)-(x2+4,y2+4),0,bf
  136.     LINE (0,0)-(600,200),1,b
  137.     CALL ssmGitter
  138.     x1=x1/4:x2=x2/4:y1=y1/4:y2=y2/4
  139.     FOR n=y1 TO y2
  140.       FOR m=x1 TO x2
  141.         sw(0,n,m)=0
  142.         sw(1,n,m)=0
  143.       NEXT m
  144.     NEXT n
  145.     mess=6:GOTO messageFresh
  146.  
  147.   ssmErase:
  148.     GOSUB just
  149.     LINE (0,0)-(600,200),0,bf
  150.     CALL ssmGitter
  151.     FOR n=0 TO 49
  152.       FOR m=0 TO 149
  153.         sw(0,n,m)=0
  154.         sw(1,n,m)=0
  155.       NEXT m
  156.     NEXT n
  157.     nnbII=1:mess=6:GOTO messageFresh
  158.  
  159.   ssmSichern:
  160.     y2=95:CALL PRGRequest(f$,df$,y2):IF f$="/" THEN ssmRefresh
  161.     GOSUB just
  162.     wi=wi-3
  163.     OPEN f$ FOR OUTPUT AS #1
  164.     FOR n=0 TO 49
  165.       FOR m=0 TO 149
  166.         WRITE#1,sw(wi,n,m)
  167.       NEXT m
  168.     NEXT n
  169.     CLOSE 1
  170.     wi=wi+3
  171.     mess=2:GOTO messageFresh            
  172.     
  173.   ssmLaden:
  174.     y2=95:CALL PRGRequest(f$,df$,y2):IF f$="/" THEN ssmRefresh
  175.     GOSUB just
  176.     OPEN f$ FOR INPUT AS #1
  177.     wi=wi-3:a=0
  178.     FOR m=1 TO 200 STEP 4
  179.       b=0
  180.       FOR n=1 TO 600 STEP 4
  181.         INPUT#1,c
  182.         IF c<>sw(wi,a,b) THEN LINE (n,m)-(n+2,m+2),c*3,bf
  183.         sw(0,a,b)=c:sw(1,a,b)=c
  184.         b=b+1
  185.       NEXT n
  186.       a=a+1
  187.     NEXT m
  188.     CLOSE
  189.     wi=wi+3
  190.     nnbII=0:mess=2:GOTO messageFresh
  191.   
  192.   ssmStartenII:
  193.     smod=2
  194.       
  195.   ssmStartenI:
  196.     ret=0:IF nnbII=1 THEN ssmSimulationsende
  197.     WINDOW OUTPUT 10:COLOR 2
  198.     IF smod=2 THEN PRINT:PRINT  "any key continues after signal black-orange-black";
  199.     PRINT:PRINT  "stop simulation with space";
  200.     WINDOW wi
  201.     GOSUB just
  202.     GOSUB ssmSimulationsinit
  203.     IF xr<xl THEN ssmSimulationsende
  204.     FOR n=0 TO 3
  205.       PALETTE n,.1,.1,1
  206.     NEXT
  207.     PALETTE 3,1,.55,0
  208.     us=0
  209.   ssmStartenMarke:
  210.     w=wi-3
  211.     IF wi=3 THEN wi=4:ELSE wi=3
  212.     yor=0:yur=0:xlr=0:xrr=0:yov=0:yuv=0:xlv=0:xrv=0:settest=0:a$=""
  213.     wi=wi-3
  214.     FOR n=yo TO yu
  215.       o=n-1:IF o=-1 THEN o=49
  216.       u=n+1:IF u=50 THEN u=0
  217.       FOR m=xl TO xr
  218.         l=m-1:IF l=-1 THEN l=149
  219.         r=m+1:IF r=150 THEN r=0
  220.         a=sw(w,o,l)+sw(w,o,r)+sw(w,u,l)+sw(w,u,r)
  221.         a=a+sw(w,o,m)+sw(w,u,m)+sw(w,n,l)+sw(w,n,r)
  222.         IF a<>2 THEN 
  223.           IF a=3 THEN c=1:ELSE c=0
  224.           IF sw(w,n,m)<>c THEN 
  225.             aa=m*4+1:bb=n*4+1:settest=1
  226.             LINE (aa,bb)-(aa+2,bb+2),c*3,bf
  227.           END IF   
  228.         ELSE 
  229.           c=sw(w,n,m)
  230.         END IF
  231.         sw(wi,n,m)=c
  232.         IF a$="" THEN a$=INKEY$
  233.       NEXT m
  234.       IF a$=" " THEN ret=1
  235.     NEXT n
  236.     IF (ret OR settest=0) AND wi=0 THEN GOTO ssmSimulationsende
  237.     FOR xx=xl TO xr
  238.       IF sw(wi,yo,xx) THEN yor=1
  239.       IF sw(wi,yu,xx) THEN yur=1
  240.     NEXT xx
  241.     FOR yy=yo TO yu
  242.       IF sw(wi,yy,xl) THEN xlr=1
  243.       IF sw(wi,yy,xr) THEN xrr=1
  244.     NEXT yy
  245.     yo=yo-yor:yu=yu+yur:xl=xl-xlr:xr=xr+xrr
  246.     FOR xx=xl+1 TO xr-1
  247.       IF sw(wi,yo+1,xx) THEN yov=1
  248.       IF sw(wi,yu-1,xx) THEN yuv=1
  249.     NEXT xx
  250.     FOR yy=yo+1 TO yu-1
  251.       IF sw(wi,yy,xl+1) THEN xlv=1
  252.       IF sw(wi,yy,xr-1) THEN xrv=1
  253.     NEXT yy
  254.     GOSUB SimulationstestI
  255.     IF us THEN
  256.       IF yo=2 THEN
  257.         FOR y=yo TO yu:FOR x=xl TO xr:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  258.         yo=y-1:us=0
  259.       END IF
  260.       IF yu=48 THEN
  261.         FOR y=yu TO yo STEP -1:FOR x=xl TO xr:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  262.         yu=y+1:us=0
  263.       END IF
  264.       IF xl=1 THEN
  265.         FOR x=xl TO xr:FOR y=yo TO yu:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  266.         xl=x-1:us=0
  267.       END IF
  268.       IF xr=148 THEN
  269.         FOR x=xr TO xl STEP -1:FOR y=yo TO yu:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  270.         xr=x+1:us=0
  271.       END IF
  272.     END IF
  273.     wi=wi+3
  274.     IF smod=2 AND ret=0 THEN GOSUB stepbystep
  275.     GOTO ssmStartenMarke
  276.         
  277.     ssmSimulationsende:
  278.       GOSUB ColorReset 
  279.       wi=3:smod=0:mess=4:GOTO messageFresh
  280.         
  281.     ssmSimulationsinit:
  282.       wi=wi-3
  283.       FOR x=0 TO 149:FOR y=0 TO 49:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  284.         xl=x-1
  285.       FOR y=0 TO 49:FOR x=0 TO 149:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  286.         yo=y-1
  287.       FOR x=149 TO 0 STEP -1:FOR y=0 TO 49:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  288.         xr=x+1
  289.       FOR y=49 TO 0 STEP -1:FOR x=0 TO 149:IF sw(wi,y,x)=0 THEN NEXT:NEXT
  290.         yu=y+1
  291.       GOSUB SimulationstestII
  292.       wi=wi+3
  293.       RETURN
  294.                  
  295.   ssmLesen:
  296.     GOSUB SchreibLeseHilfeI
  297.     c=(meno-1)*24+2:wi=wi-3
  298.     WINDOW 9
  299.     FOR n=y TO y+19
  300.     a=n-y
  301.       FOR m=x TO x+49
  302.       b=m-x:d=a*50+b
  303.         IF cs(meno,d)<>sw(wi,n,m) THEN
  304.           cs(meno,d)=sw(wi,n,m)
  305.           PSET (2+b,c+a),cs(meno,d)*2
  306.         END IF
  307.       NEXT m
  308.     NEXT n
  309.     GOSUB SchreibLeseHilfeII
  310.     
  311.   ssmSetzen:
  312.     GOSUB SchreibLeseHilfeI
  313.     GOSUB just
  314.     wi=wi-3
  315.     FOR n=y TO y+19
  316.       d=n-y
  317.       IF n>49 THEN a=n-50:ELSE a=n
  318.       FOR m=x TO x+49
  319.         e=m-x:f=d*50+e
  320.         IF m>149 THEN b=m-150:ELSE b=m
  321.         IF cs(meno,f) THEN
  322.           sw(0,a,b)=cs(meno,f)
  323.           sw(1,a,b)=cs(meno,f)
  324.           aa=a*4+1:bb=b*4+1
  325.           LINE (bb,aa)-(bb+2,aa+2),3,bf
  326.         END IF
  327.       NEXT m
  328.     NEXT n
  329.     nnbII=0:GOSUB SchreibLeseHilfeII
  330.  
  331.   SchreibLeseHilfeI:
  332.     WINDOW 9
  333.     GOSUB getMENU:IF meno=7 THEN mess=1:GOTO messageFresh
  334.     WINDOW OUTPUT 10:PRINT :PRINT "choose area";
  335.     WINDOW OUTPUT 8:LOCATE 1,8:COLOR 2:PRINT "ssm frame"
  336.     WINDOW wi
  337.     WHILE (MOUSE(0)<>0):WEND
  338.     c=0:x2=0:y2=0
  339.     WHILE (c=0)
  340.       CALL ssmMouseII(x,y,c)
  341.       x1=x*4:y1=y*4
  342.       LINE (x1,y1)-(x1+200,y1+80),2,b
  343.       IF x1<>x2 OR y1<>y2 THEN LINE (x2,y2)-(x2+200,y2+80),1,b
  344.       x2=x1:y2=y1
  345.     WEND
  346.     RETURN
  347.     
  348.   SchreibLeseHilfeII:
  349.     wi=wi+3
  350.     WINDOW wi      
  351.     LINE (x2,y2)-(x2+200,y2+80),1,b
  352.     LINE (0,0)-(600,200),1,b
  353.     mess=1:GOTO messageFresh
  354.      
  355. scs:
  356.  
  357.   ON ERROR GOTO Fehler
  358.   WINDOW CLOSE 3:WINDOW CLOSE 4
  359.   WINDOW 5,"structure construction set                         ",(0,15)-(401,176),16,1
  360.   wi=5:GOSUB just:GOSUB setMENU
  361.   MENU 2,3,1,"structure simulation mode "
  362.   c=0:colGitter=0:CALL Gitter(colGitter)
  363.   IF nnbI=0 THEN
  364.     FOR m=1 TO 160 STEP 8
  365.       FOR n=1 TO 400 STEP 8
  366.         IF cs(0,c) THEN LINE (n,m)-(n+6,m+6),3,bf
  367.         c=c+1
  368.       NEXT n
  369.     NEXT m
  370.   END IF
  371.   mess=5:GOTO messageFresh
  372.          
  373.   Sefresh:
  374.     WINDOW OUTPUT 8:LOCATE 1,8:COLOR 2:PRINT "scs mouse"
  375.     WINDOW OUTPUT 5
  376.     c=0
  377.   checkMouse:
  378.     IF c=0 THEN MouseMenue
  379.     CALL LocateMouse(x,y)
  380.     IF x>49 OR y>19 THEN MouseMenue
  381.     c=y*50+x
  382.     IF cs(0,c)=0 THEN 
  383.       cs(0,c)=1:cs(7,c)=1:col=3
  384.     ELSE 
  385.       cs(0,c)=0:cs(7,c)=0:col=0
  386.     END IF
  387.     a=x*8+1:b=y*8+1
  388.     LINE (a,b)-(a+6,b+6),col,bf:nnbI=0
  389.     a=x:b=y              
  390.   Halt:
  391.     c=MOUSE(0)
  392.     CALL LocateMouse(x,y)
  393.     IF a=x AND b=y AND c<>0 THEN Halt
  394.   MouseMenue:
  395.     CALL LocateMouse(x,y)
  396.     IF x>49 THEN x=49
  397.     IF y>19 THEN y=19
  398.     CALL showMouse(x,y,wi)
  399.     men=MENU(0)
  400.     meno=MENU(1)
  401.     IF men=2 THEN
  402.       ON meno GOTO SimModeI,SimModeII,ssm,suicide
  403.     ELSEIF men=4 THEN
  404.       ON meno-2 GOTO Schreiben,Lesen,Kopieren
  405.     ELSEIF men=5 THEN
  406.       ON meno GOTO PuANDSp,PuORSp,PuXORSp
  407.     ELSEIF men=6 THEN
  408.       IF meno=1 THEN Loeschen
  409.       IF meno=4 THEN Invertieren
  410.       IF meno=5 THEN Gitter
  411.     ELSEIF men=7 THEN
  412.       IF meno=1 THEN Sichern
  413.       IF meno=2 THEN Laden
  414.       IF meno=5 THEN Directory
  415.     END IF
  416.     c=MOUSE(0)
  417.     GOTO checkMouse
  418.     
  419.   Fehler:
  420.     WINDOW CLOSE 11
  421.     CALL Fehleranzeige
  422.     WINDOW OUTPUT wi
  423.     RESUME Sefresh
  424.         
  425.       suicide:
  426.         WINDOW OUTPUT 10:COLOR 2:PRINT 
  427.         PRINT "it`s against law, at least in Germany"
  428.         PRINT "but even computers are open to corruption ..."
  429.         PRINT "I`m not begging for money, I want bits !";
  430.         b$(1)="b":b$(2)="i":b$(3)="t":b$(4)="s"
  431.         FOR n=1 TO 4 
  432.           GOSUB continue
  433.           IF a$<>b$(n) THEN 
  434.             PRINT :PRINT "I see, you`re honest":PRINT "ok";
  435.             mess=0:GOTO messageFresh
  436.           END IF
  437.         NEXT n
  438.         MENU RESET
  439.         SYSTEM
  440.  
  441.       Lesen:
  442.         GOSUB getMENU:c=0:IF meno=7 THEN copyMarke
  443.         FOR m=1 TO 160 STEP 8
  444.           FOR n=1 TO 400 STEP 8
  445.             IF cs(0,c)<>cs(meno,c) THEN
  446.               LINE (n,m)-(n+6,m+6),cs(meno,c)*3,bf
  447.               cs(0,c)=cs(meno,c):cs(7,c)=cs(meno,c)
  448.             END IF
  449.           c=c+1
  450.           NEXT n
  451.         NEXT m
  452.         nnbI=0:GOTO copyMarke
  453.         
  454.       Kopieren:
  455.         WINDOW 9
  456.         FOR n=1 TO 2
  457.           GOSUB getMENU:a(n)=meno:IF meno=7 THEN copyMarke
  458.         NEXT n:o=a(1)
  459.         GOTO SchreibenMarke
  460.                     
  461.       Schreiben:
  462.         GOSUB getMENU:o=0:IF meno=7 THEN copyMarke
  463.       SchreibenMarke:
  464.         WINDOW OUTPUT 9
  465.         c=0:y=(meno-1)*24+2
  466.         FOR m=0 TO 19
  467.           FOR n=0 TO 49
  468.             IF cs(o,c)<>cs(meno,c) THEN 
  469.               PSET (2+n,y+m),cs(o,c)*2
  470.               cs(meno,c)=cs(o,c)
  471.             END IF
  472.             c=c+1
  473.           NEXT n
  474.         NEXT m
  475.         
  476.       copyMarke:  
  477.         WINDOW wi
  478.         mess=1:GOTO messageFresh
  479.       
  480.       Sichern:
  481.         WINDOW 9
  482.         GOSUB getMENU:IF meno=7 THEN diskMarke
  483.         WINDOW 9
  484.         y2=95:CALL PRGRequest(f$,df$,y2):IF f$="/" THEN diskMarke
  485.         OPEN f$ FOR OUTPUT AS #1
  486.         FOR n=0 TO 999
  487.           WRITE#1,cs(meno,n)
  488.         NEXT n
  489.         CLOSE 1
  490.         GOTO diskMarke
  491.         
  492.       Laden:
  493.         WINDOW 9
  494.         GOSUB getMENU:IF meno=7 THEN diskMarke
  495.         WINDOW 9
  496.         y2=95:CALL PRGRequest(f$,df$,y2):IF f$="/" THEN diskMarke
  497.         OPEN f$ FOR INPUT AS #1
  498.         FOR n=0 TO 999
  499.           INPUT#1,cs(meno,n)
  500.         NEXT n
  501.         CLOSE 1
  502.         c=0:y=(meno-1)*24+2
  503.         FOR m=0 TO 19
  504.           FOR n=0 TO 49
  505.             IF cs(meno,c)=0 THEN col=0:ELSE col=2
  506.             PSET (2+n,y+m),col
  507.             c=c+1
  508.           NEXT n
  509.         NEXT m
  510.         GOTO diskMarke
  511.          
  512.       Directory:
  513.         WINDOW OUTPUT 10:PRINT :PRINT :PRINT 
  514.         y2=80:CALL PRGRequest(f$,df$,y2):IF df$="" THEN diskMarke
  515.         WINDOW 11,,(20,30)-(395,236),0,1
  516.         COLOR 2:FILES df$
  517.         COLOR 3:PRINT  "press any key";
  518.         GOSUB continue
  519.         WINDOW CLOSE 11
  520.         
  521.       diskMarke:
  522.         WINDOW wi
  523.         mess=2:GOTO messageFresh
  524.           
  525.       Loeschen:
  526.         FOR n=0 TO 999
  527.           cs(0,n)=0:cs(7,n)=0
  528.         NEXT n
  529.         LINE (1,1)-(399,159),0,bf
  530.         IF colGitter=1 THEN colGitter=0:CALL Gitter(colGitter)
  531.         nnbI=1:GOTO Sefresh
  532.               
  533.       Invertieren:
  534.         me=1:GOTO LogikMarke
  535.       PuANDSp:
  536.         me=2:GOTO Logik
  537.       PuORSp:
  538.         me=3:GOTO Logik
  539.       PuXORSp:
  540.         me=4:GOTO Logik
  541.         
  542.         Logik:
  543.           GOSUB getMENU:IF meno=7 THEN mess=3:GOTO messageFresh
  544.         LogikMarke:  
  545.           c=0
  546.           FOR m=1 TO 160 STEP 8
  547.             FOR n=1 TO 400 STEP 8
  548.               IF me=1 THEN
  549.                 cs(0,c)=ABS(cs(0,c)-1)
  550.               ELSEIF me=2 THEN
  551.                 cs(0,c)=cs(0,c) AND cs(meno,c)
  552.               ELSEIF me=3 THEN
  553.                 cs(0,c)=cs(0,c) OR cs(meno,c)
  554.               ELSEIF me=4 THEN
  555.                 cs(0,c)=cs(0,c) XOR cs(meno,c)
  556.               END IF
  557.               LINE (n,m)-(n+6,m+6),cs(0,c)*3,bf
  558.               cs(7,c)=cs(0,c)
  559.               c=c+1
  560.             NEXT n
  561.           NEXT m
  562.           nnbI=0
  563.           IF me>1 THEN mess=3:GOTO messageFresh:ELSE GOTO Sefresh
  564.  
  565.       Gitter:
  566.         CALL Gitter(colGitter)
  567.         GOTO Sefresh
  568.  
  569.   SimModeII:
  570.     smod=2
  571.     
  572.   SimModeI:
  573.     IF nnbI=1 THEN Simulationsende
  574.     WINDOW OUTPUT 10:COLOR 2
  575.     IF smod=2 THEN PRINT:PRINT  "any key continues after signal black-orange-black";
  576.     PRINT:PRINT  "stop simulation with space";
  577.     PRINT :csrl=CSRLIN:COLOR 2:PRINT "generation# 1";
  578.     WINDOW OUTPUT 5
  579.     GOSUB Simulationsinit
  580.     IF xr<xl THEN Simulationsende
  581.     an=0:na=7:ret=0:us=0:gennr=1:sgen=1
  582.   SimModeMarke:
  583.     yor=0:yur=0:xlr=0:xrr=0:yov=0:yuv=0:xlv=0:xrv=0:settest=0:a$=""
  584.     gennr=gennr+1
  585.     WINDOW OUTPUT 10:COLOR 2:LOCATE csrl,12:PRINT gennr;
  586.     WINDOW OUTPUT 5
  587.     FOR n=yo TO yu
  588.       o=n-1:IF o=-1 THEN o=19
  589.       u=n+1:IF u=20 THEN u=0
  590.       of=o*50:uf=u*50
  591.       FOR m=xl TO xr
  592.         l=m-1:IF l=-1 THEN l=49
  593.         r=m+1:IF r=50 THEN r=0
  594.         nf=n*50
  595.         a=cs(an,of+l)+cs(an,of+r)+cs(an,uf+l)+cs(an,uf+r)
  596.         a=a+cs(an,of+m)+cs(an,uf+m)+cs(an,nf+l)+cs(an,nf+r)
  597.         IF a<>2 THEN 
  598.           IF a=3 THEN c=1:ELSE c=0
  599.           IF cs(an,nf+m)<>c THEN 
  600.             x=m*8+1:y=n*8+1:settest=1
  601.             LINE (x,y)-(x+6,y+6),c*3,bf
  602.           END IF
  603.         ELSE
  604.           c=cs(an,nf+m)
  605.         END IF
  606.         cs(na,nf+m)=c
  607.         IF a$="" THEN a$=INKEY$
  608.       NEXT m                                
  609.     NEXT n
  610.     IF a$=" " OR settest=0 THEN ret=1
  611.     hyo=yo*50:hyu=yu*50
  612.     FOR xx=xl TO xr
  613.       IF cs(na,hyo+xx) THEN yor=1
  614.       IF cs(na,hyu+xx) THEN yur=1
  615.     NEXT xx
  616.     FOR yy=yo TO yu
  617.       IF cs(na,yy*50+xl) THEN xlr=1
  618.       IF cs(na,yy*50+xr) THEN xrr=1
  619.     NEXT yy
  620.     yo=yo-yor:yu=yu+yur:xl=xl-xlr:xr=xr+xrr
  621.     hyo=(yo+1)*50:hyu=(yu-1)*50
  622.     FOR xx=xl+1 TO xr-1
  623.       IF cs(na,hyo+xx) THEN yov=1
  624.       IF cs(na,hyu+xx) THEN yuv=1
  625.     NEXT xx
  626.     FOR yy=yo+1 TO yu-1
  627.       IF cs(na,yy*50+xl+1) THEN xlv=1
  628.       IF cs(na,yy*50+xr-1) THEN xrv=1
  629.     NEXT yy
  630.     GOSUB SimulationstestI
  631.     IF us THEN
  632.       IF yo=2 THEN
  633.         FOR y=yo TO yu:FOR x=xl TO xr:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  634.         yo=y-1:us=0
  635.       END IF
  636.       IF yu=18 THEN
  637.         FOR y=yu TO yo STEP -1:FOR x=xl TO xr:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  638.         yu=y+1:us=0
  639.       END IF
  640.       IF xl=1 THEN
  641.         FOR x=xl TO xr:FOR y=yo TO yu:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  642.         xl=x-1:us=0
  643.       END IF
  644.       IF xr=48 THEN
  645.         FOR x=xr TO xl STEP -1:FOR y=yo TO yu:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  646.         xr=x+1:us=0
  647.       END IF
  648.     END IF
  649.     IF ret=1 AND na=0 THEN Simulationsende
  650.     IF an=0 THEN an=7:na=0:ELSE an=0:na=7
  651.     IF smod=2 AND ret=0 THEN GOSUB stepbystep
  652.     GOTO SimModeMarke
  653.     
  654.     Simulationsende:
  655.       smod=0:mess=4:GOTO messageFresh
  656.           
  657.     Simulationsinit:
  658.       FOR x=0 TO 49:FOR y=0 TO 19:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  659.         xl=x-1
  660.       FOR y=0 TO 19:FOR x=0 TO 49:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  661.         yo=y-1
  662.       FOR x=49 TO 0 STEP -1:FOR y=0 TO 19:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  663.         xr=x+1
  664.       FOR y=19 TO 0 STEP -1:FOR x=0 TO 49:IF cs(0,y*50+x)=0 THEN NEXT:NEXT
  665.         yu=y+1
  666.       GOSUB SimulationstestII
  667.       RETURN
  668.  
  669. SimulationstestI:
  670.   IF yor=0 AND yov=0 THEN yo=yo+1
  671.   IF yur=0 AND yuv=0 THEN yu=yu-1
  672.   IF xlr=0 AND xlv=0 THEN xl=xl+1
  673.   IF xrr=0 AND xrv=0 THEN xr=xr-1
  674.       
  675. SimulationstestII:
  676.   IF wi=5 THEN simu=19:simr=49:ELSE simu=49:simr=149
  677.   IF yo<0    THEN yu=simu:yo=0:us=1
  678.   IF yu>simu THEN yu=simu:yo=0:us=1
  679.   IF xl<0    THEN xr=simr:xl=0:us=1
  680.   IF xr>simr THEN xr=simr:xl=0:us=1
  681.   RETURN
  682.  
  683. getMENU:
  684.   WINDOW OUTPUT 10:COLOR 2:PRINT :PRINT "choose memory (mem`s MENU)";
  685.   getMENUmarke:
  686.   men=MENU(0):IF men=0 THEN getMENUmarke
  687.   meno=MENU(1):IF men<>3 THEN getMENUmarke
  688.   IF wi=5 THEN PRINT:PRINT  "just a moment ...";
  689.   WINDOW OUTPUT wi
  690.   RETURN    
  691.     
  692. ColorReset:
  693.   PALETTE 0,.1,.1,1
  694.   PALETTE 1,0,0,0
  695.   PALETTE 2,1,1,1
  696.   PALETTE 3,1,.55,0
  697. RETURN
  698.  
  699. stepbystep:  
  700.   FOR m=1 TO 2
  701.     PALETTE 3,0,0,0
  702.     FOR n=1 TO 1000:NEXT n
  703.     PALETTE 3,1,.55,0
  704.     FOR n=1 TO 1000:NEXT n
  705.   NEXT m        
  706.   GOSUB continue
  707.   IF a$=" " THEN ret=1:ELSE ret=0 
  708.   RETURN
  709.   
  710. continue:
  711.   a$=""
  712.   WHILE (a$="")
  713.     a$=INKEY$
  714.   WEND
  715.   RETURN
  716.  
  717. messageFresh:  
  718.   IF mess>0 THEN WINDOW OUTPUT 10:COLOR 2:PRINT
  719.   IF mess=1 THEN PRINT "copy terminated";
  720.   IF mess=2 THEN PRINT "disk operation terminated";
  721.   IF mess=3 THEN PRINT "logical operation terminated";
  722.   IF mess=4 THEN PRINT "simulation terminated";
  723.   IF mess=5 THEN PRINT "scs - ok";
  724.   IF mess=6 THEN PRINT "ssm - ok";
  725.   WINDOW OUTPUT wi
  726.   IF wi=5 THEN GOTO Sefresh:ELSE GOTO ssmRefresh
  727.   
  728. just:
  729.   WINDOW OUTPUT 10:COLOR 2:PRINT :PRINT "just a moment ...";
  730.   WINDOW OUTPUT wi
  731.   RETURN
  732.   
  733. setMENU:
  734.   IF wi=5 THEN nu=1:ELSE nu=0
  735.   MENU 4,1,item(nu,0):MENU 4,2,item(nu,1):MENU 4,3,item(nu,2):MENU 4,4,item(nu,3)
  736.   MENU 5,0,item(nu,4):MENU 5,1,item(nu,5):MENU 5,2,item(nu,6):MENU 5,3,item(nu,7)
  737.   MENU 6,1,item(nu,8):MENU 6,2,item(nu,9):MENU 6,3,item(nu,10):MENU 6,4,item(nu,11):MENU 6,5,item(nu,12)
  738.   MENU 7,3,item(nu,13):MENU 7,4,item(nu,14)
  739.   RETURN       
  740.  
  741. catchtheMouse:
  742.   WHILE (MOUSE(0)<>0):WEND
  743.   c=0
  744.   WHILE (c=0)
  745.     CALL ssmMouse(x,y,c)
  746.   WEND
  747.   RETURN
  748.  
  749. SUB showMouse(x,y,wi) STATIC
  750.   WINDOW OUTPUT 8:COLOR 2
  751.   LOCATE 2,8:PRINT x"        "
  752.   LOCATE 3,8:PRINT y"        ";
  753.   WINDOW OUTPUT wi   
  754. END SUB
  755.   
  756. SUB ssmMouse(x,y,c) STATIC
  757.   c=MOUSE(0):x=INT(MOUSE(1)/4):y=INT(MOUSE(2)/4)
  758.   IF x>149 THEN x=149
  759.   IF y>49 THEN y=49
  760.   wi=3:CALL showMouse(x,y,wi)
  761. END SUB
  762.  
  763. SUB ssmMouseII(x,y,c) STATIC
  764.   c=MOUSE(0):x=INT(MOUSE(1)/4):y=INT(MOUSE(2)/4)
  765.   IF x>100 THEN x=100
  766.   IF y>30 THEN y=30
  767.   wi=3:CALL showMouse(x,y,wi)
  768. END SUB
  769.     
  770. SUB Gitter(colGitter) STATIC
  771.   LINE (0,0)-(400,160),1,b
  772.   IF colGitter=0 THEN colGitter=1:ELSE colGitter=0
  773.   FOR n=8 TO 392 STEP 8
  774.     LINE (n,1)-(n,159),colGitter
  775.     IF n<153 THEN LINE (1,n)-(399,n),colGitter
  776.   NEXT n
  777.   IF colGitter=1 THEN 
  778.     MENU 6,5,1,"grid off            "
  779.   ELSE
  780.     MENU 6,5,1,"grid on             "
  781.   END IF
  782. END SUB
  783.  
  784. SUB ssmGitter STATIC
  785.   LINE (0,0)-(600,200),1,b
  786.   FOR n=4 TO 596 STEP 4
  787.     LINE (n,1)-(n,199),1
  788.     IF n<213 THEN LINE (1,n)-(599,n),1
  789.   NEXT n
  790. END SUB
  791.  
  792. SUB LocateMouse(x,y) STATIC
  793.   x=INT(MOUSE(1)/8):y=INT(MOUSE(2)/8)
  794. END SUB
  795.  
  796. SUB PRGRequest(f$,df$,y2) STATIC
  797.   WINDOW 6,"prg request - name ...",(20,30)-(395,y2),0,1
  798.   LOCATE 2,2:COLOR 2,0:PRINT "enter new name or just return":PRINT 
  799.   PRINT " directory name (old) : "df$
  800.   INPUT " directory name (new) : ",ff$
  801.   IF ff$<>"" AND ff$<>df$ THEN df$=ff$
  802.   IF y2=95 THEN
  803.     PRINT " file name      (old) : "nf$
  804.     INPUT " file name      (new) : ",ff$
  805.     IF ff$<>"" AND ff$<>nf$ THEN nf$=ff$
  806.   END IF
  807.   f$=df$+"/"+nf$
  808.   IF df$="" OR nf$="" THEN f$="/"
  809.   WINDOW CLOSE 6
  810. END SUB
  811.  
  812. SUB Fehleranzeige STATIC
  813.   WINDOW OUTPUT 10:PRINT :PRINT "attention there`s an error"
  814.   er=ERR
  815.   IF er=53 THEN
  816.      PRINT "53 - file not found";
  817.   ELSEIF er=61 THEN 
  818.     PRINT "61 - disk full";
  819.   ELSEIF er=64 THEN
  820.     PRINT "64 - bad file name";
  821.   ELSE 
  822.     PRINT "error#"ERR;
  823.   END IF
  824. END SUB
  825.